home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE23 / PASTOWEB / NewParse.pas < prev    next >
Pascal/Delphi Source File  |  1997-05-09  |  9KB  |  389 lines
  1. unit NewParse;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, SysUtils, Consts;
  7.  
  8. const
  9.   toComment = Char(5);
  10.  
  11. type
  12.   TNewParser = class(TObject)
  13.   private
  14.     FStream: TStream;
  15.     FOrigin: Longint;
  16.     FBuffer: PChar;
  17.     FBufPtr: PChar;
  18.     FBufEnd: PChar;
  19.     FSourcePtr: PChar;
  20.     FSourceEnd: PChar;
  21.     FTokenPtr: PChar;
  22.     FStringPtr: PChar;
  23.     FSourceLine: Integer;
  24.     FSaveChar: Char;
  25.     FToken: Char;
  26.     procedure ReadBuffer;
  27.     procedure SkipBlanks;
  28.   public
  29.     constructor Create(Stream: TStream);
  30.     destructor Destroy; override;
  31.     procedure CheckToken(T: Char);
  32.     procedure CheckTokenSymbol(const S: string);
  33.     procedure Error(const Ident: string);
  34.     procedure ErrorFmt(const Ident: string; const Args: array of const);
  35.     procedure ErrorStr(const Message: string);
  36.     procedure HexToBinary(Stream: TStream);
  37.     function NextToken: Char;
  38.     function SourcePos: Longint;
  39.     function TokenComponentIdent: String;
  40.     function TokenFloat: Extended;
  41.     function TokenInt: Longint;
  42.     function TokenString: string;
  43.     function TokenSymbolIs(const S: string): Boolean;
  44.     property SourceLine: Integer read FSourceLine;
  45.     property Token: Char read FToken;
  46.   end;
  47.  
  48. implementation
  49.  
  50. const
  51.   ParseBufSize = 4096;
  52.  
  53. procedure BinToHex(Buffer, Text: PChar; BufSize: Integer); assembler;
  54. asm
  55.         PUSH    ESI
  56.         PUSH    EDI
  57.         MOV     ESI,EAX
  58.         MOV     EDI,EDX
  59.         MOV     EDX,0
  60.         JMP     @@1
  61. @@0:    DB      '0123456789ABCDEF'
  62. @@1:    LODSB
  63.         MOV     DL,AL
  64.         AND     DL,0FH
  65.         MOV     AH,@@0.Byte[EDX]
  66.         MOV     DL,AL
  67.         SHR     DL,4
  68.         MOV     AL,@@0.Byte[EDX]
  69.         STOSW
  70.         DEC     ECX
  71.         JNE     @@1
  72.         POP     EDI
  73.         POP     ESI
  74. end;
  75.  
  76. function HexToBin(Text, Buffer: PChar; BufSize: Integer): Integer; assembler;
  77. asm
  78.         PUSH    ESI
  79.         PUSH    EDI
  80.         PUSH    EBX
  81.         MOV     ESI,EAX
  82.         MOV     EDI,EDX
  83.         MOV     EBX,EDX
  84.         MOV     EDX,0
  85.         JMP     @@1
  86. @@0:    DB       0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1
  87.         DB      -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
  88.         DB      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
  89.         DB      -1,10,11,12,13,14,15
  90. @@1:    LODSW
  91.         CMP     AL,'0'
  92.         JB      @@2
  93.         CMP     AL,'f'
  94.         JA      @@2
  95.         MOV     DL,AL
  96.         MOV     AL,@@0.Byte[EDX-'0']
  97.         CMP     AL,-1
  98.         JE      @@2
  99.         SHL     AL,4
  100.         CMP     AH,'0'
  101.         JB      @@2
  102.         CMP     AH,'f'
  103.         JA      @@2
  104.         MOV     DL,AH
  105.         MOV     AH,@@0.Byte[EDX-'0']
  106.         CMP     AH,-1
  107.         JE      @@2
  108.         OR      AL,AH
  109.         STOSB
  110.         DEC     ECX
  111.         JNE     @@1
  112. @@2:    MOV     EAX,EDI
  113.         SUB     EAX,EBX
  114.         POP     EBX
  115.         POP     EDI
  116.         POP     ESI
  117. end;
  118.  
  119. constructor TNewParser.Create(Stream: TStream);
  120. begin
  121.   FStream := Stream;
  122.   GetMem(FBuffer, ParseBufSize);
  123.   FBuffer[0] := #0;
  124.   FBufPtr := FBuffer;
  125.   FBufEnd := FBuffer + ParseBufSize;
  126.   FSourcePtr := FBuffer;
  127.   FSourceEnd := FBuffer;
  128.   FTokenPtr := FBuffer;
  129.   FSourceLine := 1;
  130.   NextToken;
  131. end;
  132.  
  133. destructor TNewParser.Destroy;
  134. begin
  135.   if FBuffer <> nil then
  136.   begin
  137.     FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
  138.     FreeMem(FBuffer, ParseBufSize);
  139.   end;
  140. end;
  141.  
  142. procedure TNewParser.CheckToken(T: Char);
  143. begin
  144.   if Token <> T then
  145.     case T of
  146.       toSymbol:
  147.         Error(SIdentifierExpected);
  148.       toString:
  149.         Error(SStringExpected);
  150.       toInteger, toFloat:
  151.         Error(SNumberExpected);
  152.     else
  153.       ErrorFmt(SCharExpected, [T]);
  154.     end;
  155. end;
  156.  
  157. procedure TNewParser.CheckTokenSymbol(const S: string);
  158. begin
  159.   if not TokenSymbolIs(S) then ErrorFmt(SSymbolExpected, [S]);
  160. end;
  161.  
  162. procedure TNewParser.Error(const Ident: string);
  163. begin
  164.   ErrorStr(Ident);
  165. end;
  166.  
  167. procedure TNewParser.ErrorFmt(const Ident: string; const Args: array of const);
  168. begin
  169.   ErrorStr(Format(Ident, Args));
  170. end;
  171.  
  172. procedure TNewParser.ErrorStr(const Message: string);
  173. begin
  174.   raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
  175. end;
  176.  
  177. procedure TNewParser.HexToBinary(Stream: TStream);
  178. var
  179.   Count: Integer;
  180.   Buffer: array[0..255] of Char;
  181. begin
  182.   SkipBlanks;
  183.   while FSourcePtr^ <> '}' do
  184.   begin
  185.     Count := HexToBin(FSourcePtr, Buffer, SizeOf(Buffer));
  186.     if Count = 0 then Error(SInvalidBinary);
  187.     Stream.Write(Buffer, Count);
  188.     Inc(FSourcePtr, Count * 2);
  189.     SkipBlanks;
  190.   end;
  191.   NextToken;
  192. end;
  193.  
  194. function TNewParser.NextToken: Char;
  195. var
  196.   I: Integer;
  197.   P, S: PChar;
  198. begin
  199.   SkipBlanks;
  200.   P := FSourcePtr;
  201.   FTokenPtr := P;
  202.   case P^ of
  203.     'A'..'Z', 'a'..'z', '_':
  204.       begin
  205.         Inc(P);
  206.         while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
  207.         Result := toSymbol;
  208.       end;
  209.     '#', '''':
  210.       begin
  211.         S := P;
  212.         while True do
  213.           case P^ of
  214.             '#':
  215.               begin
  216.                 Inc(P);
  217.                 I := 0;
  218.                 while P^ in ['0'..'9'] do
  219.                 begin
  220.                   I := I * 10 + (Ord(P^) - Ord('0'));
  221.                   Inc(P);
  222.                 end;
  223.                 S^ := Chr(I);
  224.                 Inc(S);
  225.               end;
  226.             '''':
  227.               begin
  228.                 Inc(P);
  229.                 while True do
  230.                 begin
  231.                   case P^ of
  232.                     #0, #10, #13:
  233.                       Error(SInvalidString);
  234.                     '''':
  235.                       begin
  236.                         Inc(P);
  237.                         if P^ <> '''' then Break;
  238.                       end;
  239.                   end;
  240.                   S^ := P^;
  241.                   Inc(S);
  242.                   Inc(P);
  243.                 end;
  244.               end;
  245.           else
  246.             Break;
  247.           end;
  248.         FStringPtr := S;
  249.         Result := toString;
  250.       end;
  251.     '$':
  252.       begin
  253.         Inc(P);
  254.         while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
  255.         Result := toInteger;
  256.       end;
  257.     '-', '0'..'9':
  258.       begin
  259.         Inc(P);
  260.         while P^ in ['0'..'9'] do Inc(P);
  261.         Result := toInteger;
  262.         while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do
  263.         begin
  264.           Inc(P);
  265.           Result := toFloat;
  266.         end;
  267.       end;
  268.     // new custom code!!!!
  269.     '{':
  270.       begin
  271.         // look for closing brace
  272.         while P^ <> '}' do
  273.           Inc(P);
  274.         // move to the next
  275.         Inc(P);
  276.         Result := toComment;
  277.       end;
  278.   else
  279.     // updated
  280.     if (P^ = '/') and (P^ <> toEOF) and ((P+1)^ = '/') then
  281.     begin
  282.       // single line comment
  283.       while P^ <> #13 do
  284.         Inc(P);
  285.       Result := toComment;
  286.     end
  287.     else
  288.     begin
  289.       Result := P^;
  290.       if Result <> toEOF then
  291.         Inc(P);
  292.     end;
  293.   end;
  294.   FSourcePtr := P;
  295.   FToken := Result;
  296. end;
  297.  
  298. procedure TNewParser.ReadBuffer;
  299. var
  300.   Count: Integer;
  301. begin
  302.   Inc(FOrigin, FSourcePtr - FBuffer);
  303.   FSourceEnd[0] := FSaveChar;
  304.   Count := FBufPtr - FSourcePtr;
  305.   if Count <> 0 then Move(FSourcePtr[0], FBuffer[0], Count);
  306.   FBufPtr := FBuffer + Count;
  307.   Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
  308.   FSourcePtr := FBuffer;
  309.   FSourceEnd := FBufPtr;
  310.   if FSourceEnd = FBufEnd then
  311.   begin
  312.     FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
  313.     if FSourceEnd = FBuffer then Error(SLineTooLong);
  314.   end;
  315.   FSaveChar := FSourceEnd[0];
  316.   FSourceEnd[0] := #0;
  317. end;
  318.  
  319. procedure TNewParser.SkipBlanks;
  320. begin
  321.   while True do
  322.   begin
  323.     case FSourcePtr^ of
  324.       #0:
  325.         begin
  326.           ReadBuffer;
  327.           if FSourcePtr^ = #0 then Exit;
  328.           Continue;
  329.         end;
  330.       #10:
  331.         Inc(FSourceLine);
  332.       #33..#255:
  333.         Exit;
  334.     end;
  335.     Inc(FSourcePtr);
  336.   end;
  337. end;
  338.  
  339. function TNewParser.SourcePos: Longint;
  340. begin
  341.   Result := FOrigin + (FTokenPtr - FBuffer);
  342. end;
  343.  
  344. function TNewParser.TokenFloat: Extended;
  345. begin
  346.   Result := StrToFloat(TokenString);
  347. end;
  348.  
  349. function TNewParser.TokenInt: Longint;
  350. begin
  351.   Result := StrToInt(TokenString);
  352. end;
  353.  
  354. function TNewParser.TokenString: string;
  355. var
  356.   L: Integer;
  357. begin
  358.   if FToken = toString then
  359.     L := FStringPtr - FTokenPtr else
  360.     L := FSourcePtr - FTokenPtr;
  361.   SetString(Result, FTokenPtr, L);
  362. end;
  363.  
  364. function TNewParser.TokenSymbolIs(const S: string): Boolean;
  365. begin
  366.   Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
  367. end;
  368.  
  369. function TNewParser.TokenComponentIdent: String;
  370. var
  371.   P: PChar;
  372. begin
  373.   CheckToken(toSymbol);
  374.   P := FSourcePtr;
  375.   while P^ = '.' do
  376.   begin
  377.     Inc(P);
  378.     if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
  379.       Error(SIdentifierExpected);
  380.     repeat
  381.       Inc(P)
  382.     until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  383.   end;
  384.   FSourcePtr := P;
  385.   Result := TokenString;
  386. end;
  387.  
  388. end.
  389.